home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / icon / Source / Icont / C / Tcode < prev    next >
Encoding:
Text File  |  1990-07-20  |  23.7 KB  |  1,075 lines
  1. /*
  2.  * tcode.c -- translator functions for traversing parse trees and generating
  3.  *  code.
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "general.h"
  8. #include "tproto.h"
  9. #include "globals.h"
  10. #include "trans.h"
  11. #include "token.h"
  12. #include "tree.h"
  13. #include "tsym.h"
  14.  
  15. /*
  16.  * Prototypes.
  17.  */
  18.  
  19. hidden int    alclab        Params((int n));
  20. hidden novalue    binop        Params((int op));
  21. hidden novalue    emit        Params((char *s));
  22. hidden novalue    emitl        Params((char *s,int a));
  23. hidden novalue    emitlab        Params((int l));
  24. hidden novalue    emitn        Params((char *s,int a));
  25. hidden novalue    emits        Params((char *s,char *a));
  26. hidden novalue    setloc        Params((nodeptr n));
  27. hidden int    traverse    Params((nodeptr t));
  28. hidden novalue    unopa        Params((int op, nodeptr t));
  29. hidden novalue    unopb        Params((int op));
  30.  
  31. extern int tfatals;
  32. extern int nocode;
  33. extern char *comfile;
  34.  
  35. /*
  36.  * Code generator parameters.
  37.  */
  38.  
  39. #define LoopDepth   20        /* max. depth of nested loops */
  40. #define CaseDepth   10        /* max. depth of nested case statements */
  41. #define CreatDepth  10        /* max. depth of nested create statements */
  42.  
  43. /*
  44.  * loopstk structures hold information about nested loops.
  45.  */
  46. struct loopstk {
  47.    int nextlab;            /* label for next exit */
  48.    int breaklab;        /* label for break exit */
  49.    int markcount;        /* number of marks */
  50.    int ltype;            /* loop type */
  51.    };
  52.  
  53. /*
  54.  * casestk structure hold information about case statements.
  55.  */
  56. struct casestk {
  57.    int endlab;            /* label for exit from case statement */
  58.    nodeptr deftree;        /* pointer to tree for default clause */
  59.    };
  60.  
  61. /*
  62.  * creatstk structures hold information about create statements.
  63.  */
  64. struct creatstk {
  65.    int nextlab;            /* previous value of nextlab */
  66.    int breaklab;        /* previous value of breaklab */
  67.    };
  68. static int nextlab;        /* next label allocated by alclab() */
  69.  
  70. /*
  71.  * codegen - traverse tree t, generating code.
  72.  */
  73.  
  74. novalue codegen(t)
  75. nodeptr t;
  76.    {
  77.    nextlab = 1;
  78.    traverse(t);
  79.    }
  80.  
  81. /*
  82.  * traverse - traverse tree rooted at t and generate code.  This is just
  83.  *  plug and chug code for each of the node types.
  84.  */
  85.  
  86. static int traverse(t)
  87. register nodeptr t;
  88.    {
  89.    register int lab, n, i;
  90.    struct loopstk loopsave;
  91.    static struct loopstk loopstk[LoopDepth];    /* loop stack */
  92.    static struct loopstk *loopsp;
  93.    static struct casestk casestk[CaseDepth];    /* case stack */
  94.    static struct casestk *casesp;
  95.    static struct creatstk creatstk[CreatDepth]; /* create stack */
  96.    static struct creatstk *creatsp;
  97.  
  98.    n = 1;
  99.    switch (TType(t)) {
  100.  
  101.       case N_Activat:            /* co-expression activation */
  102.      if (Val0(Tree0(t)) == AUGACT) {
  103.         emit("pnull");
  104.         }
  105.      traverse(Tree2(t));        /* evaluate result expression */
  106.      if (Val0(Tree0(t)) == AUGACT)
  107.         emit("sdup");
  108.      traverse(Tree1(t));        /* evaluate activate expression */
  109.      setloc(t);
  110.      emit("coact");
  111.      if (Val0(Tree0(t)) == AUGACT)
  112.         emit("asgn");
  113.      break;
  114.  
  115.       case N_Alt:            /* alternation */
  116.      lab = alclab(2);
  117.      emitl("mark", lab);
  118.      loopsp->markcount++;
  119.      traverse(Tree0(t));        /* evaluate first alternative */
  120.      loopsp->markcount--;
  121.      emit("esusp");                 /*  and suspend with its result */
  122.      emitl("goto", lab+1);
  123.      emitlab(lab);
  124.      traverse(Tree1(t));        /* evaluate second alternative */
  125.      emitlab(lab+1);
  126.      break;
  127.  
  128.       case N_Augop:            /* augmented assignment */
  129.       case N_Binop:            /*  or a binary operator */
  130.      emit("pnull");
  131.      traverse(Tree1(t));
  132.      if (TType(t) == N_Augop)
  133.         emit("dup");
  134.      traverse(Tree2(t));
  135.      setloc(t);
  136.      binop((int)Val0(Tree0(t)));
  137.      break;
  138.  
  139.       case N_Bar:            /* repeated alternation */
  140.      lab = alclab(1);
  141.      emitlab(lab);
  142.      emit("mark0");         /* fail if expr fails first time */
  143.      loopsp->markcount++;
  144.      traverse(Tree0(t));        /* evaluate first alternative */
  145.      loopsp->markcount--;
  146.      emitl("chfail", lab);          /* change to loop on failure */
  147.      emit("esusp");                 /* suspend result */
  148.      break;
  149.  
  150.       case N_Break:            /* break expression */
  151.      if (loopsp->breaklab <= 0)
  152.         nfatal(t, "invalid context for break");
  153.      else {
  154.         for (i = 0; i < loopsp->markcount; i++)
  155.            emit("unmark");
  156.         loopsave = *loopsp--;
  157.         traverse(Tree0(t));
  158.         *++loopsp = loopsave;
  159.         emitl("goto", loopsp->breaklab);
  160.         }
  161.      break;
  162.  
  163.       case N_Case:            /* case expression */
  164.      lab = alclab(1);
  165.      casesp++;
  166.      casesp->endlab = lab;
  167.      casesp->deftree = NULL;
  168.      emit("mark0");
  169.      loopsp->markcount++;
  170.      traverse(Tree0(t));        /* evaluate control expression */
  171.      loopsp->markcount--;
  172.      emit("eret");
  173.      traverse(Tree1(t));        /* do rest of case (CLIST) */
  174.      if (casesp->deftree != NULL) { /* evaluate default clause */
  175.         emit("pop");
  176.         traverse(casesp->deftree);
  177.         }
  178.      else
  179.         emit("efail");
  180.      emitlab(lab);            /* end label */
  181.      casesp--;
  182.      break;
  183.  
  184.       case N_Ccls:            /* case expression clause */
  185.      if (TType(Tree0(t)) == N_Res && /* default clause */
  186.          Val0(Tree0(t)) == DEFAULT) {
  187.         if (casesp->deftree != NULL)
  188.            nfatal(t, "more than one default clause");
  189.         else
  190.            casesp->deftree = Tree1(t);
  191.         }
  192.      else {                /* case clause */
  193.         lab = alclab(1);
  194.         emitl("mark", lab);
  195.         loopsp->markcount++;
  196.         emit("ccase");
  197.         traverse(Tree0(t));        /* evaluate selector */
  198.         setloc(t);
  199.         emit("eqv");
  200.         loopsp->markcount--;
  201.         emit("unmark");
  202.         emit("pop");
  203.         traverse(Tree1(t));        /* evaluate expression */
  204.         emitl("goto", casesp->endlab); /* goto end label */
  205.         emitlab(lab);        /* label for next clause */
  206.         }
  207.      break;
  208.  
  209.       case N_Clist:            /* list of case clauses */
  210.      traverse(Tree0(t));
  211.      traverse(Tree1(t));
  212.      break;
  213.  
  214.       case N_Conj:            /* conjunction */
  215.      if (Val0(Tree0(t)) == AUGAND) {
  216.         emit("pnull");
  217.         }
  218.      traverse(Tree1(t));
  219.      if (Val0(Tree0(t)) != AUGAND)
  220.         emit("pop");
  221.      traverse(Tree2(t));
  222.      if (Val0(Tree0(t)) == AUGAND) {
  223.         setloc(t);
  224.         emit("asgn");
  225.         }
  226.      break;
  227.  
  228.       case N_Create:            /* create expression */
  229.      creatsp++;
  230.      creatsp->nextlab = loopsp->nextlab;
  231.      creatsp->breaklab = loopsp->breaklab;
  232.      loopsp->nextlab = 0;        /* make break and next illegal */
  233.      loopsp->breaklab = 0;
  234.      lab = alclab(3);
  235.      emitl("goto", lab+2);          /* skip over code for co-expression */
  236.      emitlab(lab);            /* entry point */
  237.      emit("pop");                   /* pop the result from activation */
  238.      emitl("mark", lab+1);
  239.      loopsp->markcount++;
  240.      traverse(Tree0(t));        /* traverse code for co-expression */
  241.      loopsp->markcount--;
  242.      setloc(t);
  243.      emit("coret");                 /* return to activator */
  244.      emit("efail");                 /* drive co-expression */
  245.      emitlab(lab+1);        /* loop on exhaustion */
  246.      emit("cofail");                /* and fail each time */
  247.      emitl("goto", lab+1);
  248.      emitlab(lab+2);
  249.      emitl("create", lab);          /* create entry block */
  250.      loopsp->nextlab = creatsp->nextlab;   /* legalize break and next */
  251.      loopsp->breaklab = creatsp->breaklab;
  252.      creatsp--;
  253.      break;
  254.  
  255.       case N_Cset:            /* cset literal */
  256.      emitn("cset", (int)Val0(t));
  257.      break;
  258.  
  259.       case N_Elist:            /* expression list */
  260.      n = traverse(Tree0(t));
  261.      n += traverse(Tree1(t));
  262.      break;
  263.  
  264.       case N_Empty:            /* a missing expression */
  265.      emit("pnull");
  266.      break;
  267.  
  268.       case N_Field:            /* field reference */
  269.      emit("pnull");
  270.      traverse(Tree0(t));
  271.      setloc(t);
  272.      emits("field", Str0(Tree1(t)));
  273.      break;
  274.  
  275.  
  276.       case N_Id:            /* identifier */
  277.      emitn("var", (int)Val0(t));
  278.      break;
  279.  
  280.       case N_If:            /* if expression */
  281.      if (TType(Tree2(t)) == N_Empty) {
  282.         lab = 0;
  283.         emit("mark0");
  284.         }
  285.      else {
  286.         lab = alclab(2);
  287.         emitl("mark", lab);
  288.         }
  289.      loopsp->markcount++;
  290.      traverse(Tree0(t));
  291.      loopsp->markcount--;
  292.      emit("unmark");
  293.      traverse(Tree1(t));
  294.      if (lab > 0) {
  295.         emitl("goto", lab+1);
  296.         emitlab(lab);
  297.         traverse(Tree2(t));
  298.         emitlab(lab+1);
  299.         }
  300.      break;
  301.  
  302.       case N_Int:            /* integer literal */
  303.      emitn("int", (int)Val0(t));
  304.      break;
  305.  
  306.  
  307.       case N_Apply:            /* application */
  308.          traverse(Tree0(t));
  309.          traverse(Tree1(t));
  310.          emitn("invoke", -1);
  311.          break;
  312.  
  313.       case N_Invok:            /* invocation */
  314.      if (TType(Tree0(t)) != N_Empty) {
  315.         traverse(Tree0(t));
  316.          }
  317.      else {
  318.         emit("pushn1");             /* default to -1(e1,...,en) */
  319.         }
  320.      n = traverse(Tree1(t));
  321.      setloc(t);
  322.      emitn("invoke", n);
  323.      n = 1;
  324.      break;
  325.  
  326.       case N_Key:            /* keyword reference */
  327.      setloc(t);
  328.      emitn("keywd", (int)Val0(t));
  329.      break;
  330.  
  331.       case N_Limit:            /* limitation */
  332.      traverse(Tree1(t));
  333.      setloc(t);
  334.      emit("limit");
  335.      loopsp->markcount++;
  336.      traverse(Tree0(t));
  337.      loopsp->markcount--;
  338.      emit("lsusp");
  339.      break;
  340.  
  341.       case N_List:            /* list construction */
  342.      emit("pnull");
  343.      if (TType(Tree0(t)) == N_Empty)
  344.         n = 0;
  345.      else
  346.         n = traverse(Tree0(t));
  347.      setloc(t);
  348.      emitn("llist", n);
  349.      n = 1;
  350.      break;
  351.  
  352.       case N_Loop:            /* loop */
  353.      switch ((int)Val0(Tree0(t))) {
  354.         case EVERY:
  355.            lab = alclab(2);
  356.            loopsp++;
  357.            loopsp->ltype = EVERY;
  358.            loopsp->nextlab = lab;
  359.            loopsp->breaklab = lab + 1;
  360.            loopsp->markcount = 1;
  361.            emit("mark0");
  362.            traverse(Tree1(t));
  363.            emit("pop");
  364.            if (TType(Tree2(t)) != N_Empty) {   /* every e1 do e2 */
  365.           emit("mark0");
  366.           loopsp->ltype = N_Loop;
  367.           loopsp->markcount++;
  368.           traverse(Tree2(t));
  369.           loopsp->markcount--;
  370.           emit("unmark");
  371.           }
  372.            emitlab(loopsp->nextlab);
  373.            emit("efail");
  374.            emitlab(loopsp->breaklab);
  375.            loopsp--;
  376.            break;
  377.  
  378.         case REPEAT:
  379.            lab = alclab(3);
  380.            loopsp++;
  381.            loopsp->ltype = N_Loop;
  382.            loopsp->nextlab = lab + 1;
  383.            loopsp->breaklab = lab + 2;
  384.            loopsp->markcount = 1;
  385.            emitlab(lab);
  386.            emitl("mark", lab);
  387.            traverse(Tree1(t));
  388.            emitlab(loopsp->nextlab);
  389.            emit("unmark");
  390.            emitl("goto", lab);
  391.            emitlab(loopsp->breaklab);
  392.            loopsp--;
  393.            break;
  394.  
  395.         case SUSPEND:            /* suspension expression */
  396.            if (creatsp > creatstk)
  397.           nfatal(t, "invalid context for suspend");
  398.            lab = alclab(2);
  399.            loopsp++;
  400.            loopsp->ltype = EVERY;        /* like every ... do for next */
  401.            loopsp->nextlab = lab;
  402.            loopsp->breaklab = lab + 1;
  403.            loopsp->markcount = 1;
  404.            emit("mark0");
  405.            traverse(Tree1(t));
  406.            setloc(t);
  407.            emit("psusp");
  408.            emit("pop");
  409.            if (TType(Tree2(t)) != N_Empty) { /* suspend e1 do e2 */
  410.           emit("mark0");
  411.           loopsp->ltype = N_Loop;
  412.           loopsp->markcount++;
  413.           traverse(Tree2(t));
  414.           loopsp->markcount--;
  415.           emit("unmark");
  416.           }
  417.            emitlab(loopsp->nextlab);
  418.            emit("efail");
  419.            emitlab(loopsp->breaklab);
  420.            loopsp--;
  421.            break;
  422.  
  423.         case WHILE:
  424.            lab = alclab(3);
  425.            loopsp++;
  426.            loopsp->ltype = N_Loop;
  427.            loopsp->nextlab = lab + 1;
  428.            loopsp->breaklab = lab + 2;
  429.            loopsp->markcount = 1;
  430.            emitlab(lab);
  431.            emit("mark0");
  432.            traverse(Tree1(t));
  433.            if (TType(Tree2(t)) != N_Empty) {
  434.           emit("unmark");
  435.           emitl("mark", lab);
  436.           traverse(Tree2(t));
  437.           }
  438.            emitlab(loopsp->nextlab);
  439.            emit("unmark");
  440.            emitl("goto", lab);
  441.            emitlab(loopsp->breaklab);
  442.            loopsp--;
  443.            break;
  444.  
  445.         case UNTIL:
  446.            lab = alclab(4);
  447.            loopsp++;
  448.            loopsp->ltype = N_Loop;
  449.            loopsp->nextlab = lab + 2;
  450.            loopsp->breaklab = lab + 3;
  451.            loopsp->markcount = 1;
  452.            emitlab(lab);
  453.            emitl("mark", lab+1);
  454.            traverse(Tree1(t));
  455.            emit("unmark");
  456.            emit("efail");
  457.            emitlab(lab+1);
  458.            emitl("mark", lab);
  459.            traverse(Tree2(t));
  460.            emitlab(loopsp->nextlab);
  461.            emit("unmark");
  462.            emitl("goto", lab);
  463.            emitlab(loopsp->breaklab);
  464.            loopsp--;
  465.            break;
  466.         }
  467.      break;
  468.  
  469.       case N_Next:            /* next expression */
  470.      if (loopsp < loopstk || loopsp->nextlab <= 0)
  471.         nfatal(t, "invalid context for next");
  472.      else {
  473.         if (loopsp->ltype != EVERY && loopsp->markcount > 1)
  474.            for (i = 0; i < loopsp->markcount - 1; i++)
  475.           emit("unmark");
  476.         emitl("goto", loopsp->nextlab);
  477.         }
  478.      break;
  479.  
  480.       case N_Not:            /* not expression */
  481.      lab = alclab(1);
  482.      emitl("mark", lab);
  483.      loopsp->markcount++;
  484.      traverse(Tree0(t));
  485.      loopsp->markcount--;
  486.      emit("unmark");
  487.      emit("efail");
  488.      emitlab(lab);
  489.      emit("pnull");
  490.      break;
  491.  
  492.       case N_Proc:            /* procedure */
  493.      loopsp = loopstk;
  494.      loopsp->nextlab = 0;
  495.      loopsp->breaklab = 0;
  496.      loopsp->markcount = 0;
  497.      casesp = casestk;
  498.      creatsp = creatstk;
  499.  
  500.  
  501.      writecheck(fprintf(codefile, "proc %s\n", Str0(Tree0(t))));
  502.      lout(codefile);
  503.      cout(codefile);
  504.  
  505.      emit("declend");
  506.      setloc(t);
  507.      if (TType(Tree1(t)) != N_Empty) {
  508.         lab = alclab(1);
  509.         emitl("init", lab);
  510.         emitl("mark", lab);
  511.         traverse(Tree1(t));
  512.         emit("unmark");
  513.         emitlab(lab);
  514.         }
  515.      if (TType(Tree2(t)) != N_Empty)
  516.         traverse(Tree2(t));
  517.      setloc(Tree3(t));
  518.      emit("pfail");
  519.      emit("end");
  520.      if (!silent)
  521.         fprintf(stderr, "  %s (%lu/%ld)\n", Str0(Tree0(t)),
  522.         (unsigned long)DiffPtrs(tfree,tree)/sizeof(word),(long)tsize);
  523.      break;
  524.  
  525.       case N_Real:            /* real literal */
  526.      emitn("real", (int)Val0(t));
  527.      break;
  528.  
  529.       case N_Ret:            /* return expression */
  530.      if (creatsp > creatstk)
  531.         nfatal(t, "invalid context for return or fail");
  532.      if (Val0(Tree0(t)) != FAIL) {
  533.         lab = alclab(1);
  534.         emitl("mark", lab);
  535.         loopsp->markcount++;
  536.         traverse(Tree1(t));
  537.         loopsp->markcount--;
  538.         setloc(t);
  539.         emit("pret");
  540.         emitlab(lab);
  541.         }
  542.      setloc(t);
  543.      emit("pfail");
  544.      break;
  545.  
  546.       case N_Scan:            /* scanning expression */
  547.      if (Val0(Tree0(t)) == SCANASGN)
  548.         emit("pnull");
  549.      traverse(Tree1(t));
  550.      if (Val0(Tree0(t)) == SCANASGN)
  551.         emit("sdup");
  552.      setloc(t);
  553.      emit("bscan");
  554.      traverse(Tree2(t));
  555.      setloc(t);
  556.      emit("escan");
  557.      if (Val0(Tree0(t)) == SCANASGN)
  558.         emit("asgn");
  559.      break;
  560.  
  561.       case N_Sect:            /* section operation */
  562.      emit("pnull");
  563.      traverse(Tree1(t));
  564.      traverse(Tree2(t));
  565.      if (Val0(Tree0(t)) == PCOLON || Val0(Tree0(t)) == MCOLON)
  566.         emit("dup");
  567.      traverse(Tree3(t));
  568.      setloc(Tree0(t));
  569.      if (Val0(Tree0(t)) == PCOLON)
  570.         emit("plus");
  571.      else if (Val0(Tree0(t)) == MCOLON)
  572.         emit("minus");
  573.      setloc(t);
  574.      emit("sect");
  575.      break;
  576.  
  577.       case N_Slist:            /* semicolon-separated expr list */
  578.      lab = alclab(1);
  579.      emitl("mark", lab);
  580.      loopsp->markcount++;
  581.      traverse(Tree0(t));
  582.      loopsp->markcount--;
  583.      emit("unmark");
  584.      emitlab(lab);
  585.      traverse(Tree1(t));
  586.      break;
  587.  
  588.       case N_Str:            /* string literal */
  589.      emitn("str", (int)Val0(t));
  590.      break;
  591.  
  592.       case N_To:            /* to expression */
  593.      emit("pnull");
  594.      traverse(Tree0(t));
  595.      traverse(Tree1(t));
  596.      emit("push1");
  597.      setloc(t);
  598.      emit("toby");
  599.      break;
  600.  
  601.       case N_ToBy:            /* to-by expression */
  602.      emit("pnull");
  603.      traverse(Tree0(t));
  604.      traverse(Tree1(t));
  605.      traverse(Tree2(t));
  606.      setloc(t);
  607.      emit("toby");
  608.      break;
  609.  
  610.       case N_Unop:            /* unary operator */
  611.      unopa((int)Val0(Tree0(t)),t);
  612.      traverse(Tree1(t));
  613.      setloc(t);
  614.      unopb((int)Val0(Tree0(t)));
  615.      break;
  616.  
  617.       default:
  618.      emitn("?????", TType(t));
  619.      tsyserr("traverse: undefined node type");
  620.       }
  621.    return n;
  622.    }
  623.  
  624. /*
  625.  * binop emits code for binary operators.  For non-augmented operators,
  626.  *  the name of operator is emitted.  For augmented operators, an "asgn"
  627.  *  is emitted after the name of the operator.
  628.  */
  629. static novalue binop(op)
  630. int op;
  631.    {
  632.    register int asgn;
  633.    register char *name;
  634.  
  635.    asgn = 0;
  636.    switch (op) {
  637.  
  638.       case ASSIGN:
  639.      name = "asgn";
  640.      break;
  641.  
  642.       case CARETASGN:
  643.      asgn++;
  644.       case CARET:
  645.      name = "power";
  646.      break;
  647.  
  648.       case CONCATASGN:
  649.      asgn++;
  650.       case CONCAT:
  651.      name = "cat";
  652.      break;
  653.  
  654.       case DIFFASGN:
  655.      asgn++;
  656.       case DIFF:
  657.      name = "diff";
  658.      break;
  659.  
  660.       case AUGEQV:
  661.      asgn++;
  662.       case EQUIV:
  663.      name = "eqv";
  664.      break;
  665.  
  666.       case INTERASGN:
  667.      asgn++;
  668.       case INTER:
  669.      name = "inter";
  670.      break;
  671.  
  672.       case LBRACK:
  673.      name = "subsc";
  674.      break;
  675.  
  676.       case LCONCATASGN:
  677.      asgn++;
  678.       case LCONCAT:
  679.      name = "lconcat";
  680.      break;
  681.  
  682.       case AUGSEQ:
  683.      asgn++;
  684.       case LEXEQ:
  685.      name = "lexeq";
  686.      break;
  687.  
  688.       case AUGSGE:
  689.      asgn++;
  690.       case LEXGE:
  691.      name = "lexge";
  692.      break;
  693.  
  694.       case AUGSGT:
  695.      asgn++;
  696.       case LEXGT:
  697.      name = "lexgt";
  698.      break;
  699.  
  700.       case AUGSLE:
  701.      asgn++;
  702.       case LEXLE:
  703.      name = "lexle";
  704.      break;
  705.  
  706.       case AUGSLT:
  707.      asgn++;
  708.       case LEXLT:
  709.      name = "lexlt";
  710.      break;
  711.  
  712.       case AUGSNE:
  713.      asgn++;
  714.       case LEXNE:
  715.      name = "lexne";
  716.      break;
  717.  
  718.       case MINUSASGN:
  719.      asgn++;
  720.       case MINUS:
  721.      name = "minus";
  722.      break;
  723.  
  724.       case MODASGN:
  725.      asgn++;
  726.       case MOD:
  727.      name = "mod";
  728.      break;
  729.  
  730.       case AUGNEQV:
  731.      asgn++;
  732.       case NOTEQUIV:
  733.      name = "neqv";
  734.      break;
  735.  
  736.       case AUGEQ:
  737.      asgn++;
  738.       case NUMEQ:
  739.      name = "numeq";
  740.      break;
  741.  
  742.       case AUGGE:
  743.      asgn++;
  744.       case NUMGE:
  745.      name = "numge";
  746.      break;
  747.  
  748.       case AUGGT:
  749.      asgn++;
  750.       case NUMGT:
  751.      name = "numgt";
  752.      break;
  753.  
  754.       case AUGLE:
  755.      asgn++;
  756.       case NUMLE:
  757.      name = "numle";
  758.      break;
  759.  
  760.       case AUGLT:
  761.      asgn++;
  762.       case NUMLT:
  763.      name = "numlt";
  764.      break;
  765.  
  766.       case AUGNE:
  767.      asgn++;
  768.       case NUMNE:
  769.      name = "numne";
  770.      break;
  771.  
  772.       case PLUSASGN:
  773.      asgn++;
  774.       case PLUS:
  775.      name = "plus";
  776.      break;
  777.  
  778.       case REVASSIGN:
  779.      name = "rasgn";
  780.      break;
  781.  
  782.       case REVSWAP:
  783.      name = "rswap";
  784.      break;
  785.  
  786.       case SLASHASGN:
  787.      asgn++;
  788.       case SLASH:
  789.      name = "div";
  790.      break;
  791.  
  792.       case STARASGN:
  793.      asgn++;
  794.       case STAR:
  795.      name = "mult";
  796.      break;
  797.  
  798.       case SWAP:
  799.      name = "swap";
  800.      break;
  801.  
  802.       case UNIONASGN:
  803.      asgn++;
  804.       case UNION:
  805.      name = "unions";
  806.      break;
  807.  
  808.       default:
  809.      emitn("?binop", op);
  810.      tsyserr("binop: undefined binary operator");
  811.       }
  812.    emit(name);
  813.    if (asgn)
  814.       emit("asgn");
  815.  
  816.    }
  817. /*
  818.  * unopa and unopb handle code emission for unary operators. unary operator
  819.  *  sequences that are the same as binary operator sequences are recognized
  820.  *  by the lexical analyzer as binary operators.  For example, ~===x means to
  821.  *  do three tab(match(...)) operations and then a cset complement, but the
  822.  *  lexical analyzer sees the operator sequence as the "neqv" binary
  823.  *  operation.    unopa and unopb unravel tokens of this form.
  824.  *
  825.  * When a N_Unop node is encountered, unopa is called to emit the necessary
  826.  *  number of "pnull" operations to receive the intermediate results.  This
  827.  *  amounts to a pnull for each operation.
  828.  */
  829. static novalue unopa(op,t)
  830. int op;
  831. nodeptr t;
  832.    {
  833.    switch (op) {
  834.       case NOTEQUIV:        /* unary ~ and three = operators */
  835.      emit("pnull");
  836.       case LEXNE:        /* unary ~ and two = operators */
  837.       case EQUIV:        /* three unary = operators */
  838.      emit("pnull");
  839.       case NUMNE:        /* unary ~ and = operators */
  840.       case UNION:        /* two unary + operators */
  841.       case DIFF:        /* two unary - operators */
  842.       case LEXEQ:        /* two unary = operators */
  843.       case INTER:        /* two unary * operators */
  844.      emit("pnull");
  845.       case BACKSLASH:        /* unary \ operator */
  846.       case BANG:        /* unary ! operator */
  847.       case CARET:        /* unary ^ operator */
  848.       case PLUS:        /* unary + operator */
  849.       case TILDE:        /* unary ~ operator */
  850.       case MINUS:        /* unary - operator */
  851.       case NUMEQ:        /* unary = operator */
  852.       case STAR:        /* unary * operator */
  853.       case QMARK:        /* unary ? operator */
  854.       case SLASH:        /* unary / operator */
  855.      emit("pnull");
  856.      break;
  857.       case DOT:            /* unary . operator */
  858.          if (TType(Tree1(t)) == N_Int || TType(Tree1(t)) == N_Real) {
  859.             if (!silent) {
  860.                nfatal(t,"dereferencing operator applied to numeric literal");
  861.                tfatals--;            /* for now */
  862.                nocode--;
  863.                }
  864.             }
  865.          emit("pnull");
  866.          break;
  867.       default:
  868.      tsyserr("unopa: undefined unary operator");
  869.       }
  870.    }
  871.  
  872. /*
  873.  * unopb is the back-end code emitter for unary operators.  It emits
  874.  *  the operations represented by the token op.  For tokens representing
  875.  *  a single operator, the name of the operator is emitted.  For tokens
  876.  *  representing a sequence of operators, recursive calls are used.  In
  877.  *  such a case, the operator sequence is "scanned" from right to left
  878.  *  and unopb is called with the token for the appropriate operation.
  879.  *
  880.  * For example, consider the sequence of calls and code emission for "~===":
  881.  *    unopb(NOTEQUIV)        ~===
  882.  *        unopb(NUMEQ)    =
  883.  *        emits "tabmat"
  884.  *        unopb(NUMEQ)    =
  885.  *        emits "tabmat"
  886.  *        unopb(NUMEQ)    =
  887.  *        emits "tabmat"
  888.  *        emits "compl"
  889.  */
  890. static novalue unopb(op)
  891. int op;
  892.    {
  893.    register char *name;
  894.  
  895.    switch (op) {
  896.  
  897.       case DOT:            /* unary . operator */
  898.      name = "value";
  899.      break;
  900.  
  901.       case BACKSLASH:        /* unary \ operator */
  902.      name = "nonnull";
  903.      break;
  904.  
  905.       case BANG:        /* unary ! operator */
  906.      name = "bang";
  907.      break;
  908.  
  909.       case CARET:        /* unary ^ operator */
  910.      name = "refresh";
  911.      break;
  912.  
  913.       case UNION:        /* two unary + operators */
  914.      unopb(PLUS);
  915.       case PLUS:        /* unary + operator */
  916.      name = "number";
  917.      break;
  918.  
  919.       case NOTEQUIV:        /* unary ~ and three = operators */
  920.      unopb(NUMEQ);
  921.       case LEXNE:        /* unary ~ and two = operators */
  922.      unopb(NUMEQ);
  923.       case NUMNE:        /* unary ~ and = operators */
  924.      unopb(NUMEQ);
  925.       case TILDE:        /* unary ~ operator (cset compl) */
  926.      name = "compl";
  927.      break;
  928.  
  929.       case DIFF:        /* two unary - operators */
  930.      unopb(MINUS);
  931.       case MINUS:        /* unary - operator */
  932.      name = "neg";
  933.      break;
  934.  
  935.       case EQUIV:        /* three unary = operators */
  936.      unopb(NUMEQ);
  937.       case LEXEQ:        /* two unary = operators */
  938.      unopb(NUMEQ);
  939.       case NUMEQ:        /* unary = operator */
  940.      name = "tabmat";
  941.      break;
  942.  
  943.       case INTER:        /* two unary * operators */
  944.      unopb(STAR);
  945.       case STAR:        /* unary * operator */
  946.      name = "size";
  947.      break;
  948.  
  949.       case QMARK:        /* unary ? operator */
  950.      name = "random";
  951.      break;
  952.  
  953.       case SLASH:        /* unary / operator */
  954.      name = "null";
  955.      break;
  956.  
  957.       default:
  958.      emitn("?unop", op);
  959.      tsyserr("unopb: undefined unary operator");
  960.       }
  961.    emit(name);
  962.    }
  963.  
  964. /*
  965.  * setloc emits "filen" and "line" directives for the source location of
  966.  *  node n.  A directive is only emitted if the corrosponding value
  967.  *  has changed since the last time setloc was called.  Note:  File(n)
  968.  *  reportedly occasionally points at uninitialized data, producing
  969.  *  bogus results (as well as reams of filen commands).  We could use
  970.  *  comfile here instead; that would ignore any #line directives.
  971.  */
  972. static char *lastfiln = NULL;
  973. static int lastline = 0;
  974.  
  975. #ifdef EvalTrace
  976. static int lastcol = 0;
  977. #endif                    /* EvalTrace */
  978.  
  979. static novalue setloc(n)
  980. nodeptr n;
  981.    {
  982.    if ((n != NULL) &&
  983.       (TType(n) != N_Empty) &&
  984.       (File(n) != NULL) &&
  985.       (lastfiln == NULL || strcmp(File(n), lastfiln) != 0)) {
  986.          lastfiln = File(n);
  987.          emits("filen", lastfiln);
  988.          }
  989.    if (Line(n) != lastline) {
  990.       lastline = Line(n);
  991.       emitn("line", Line(n));
  992.          }
  993.  
  994. #ifdef EvalTrace
  995.    if (Col(n) != lastcol) {
  996.       lastcol = Col(n);
  997.       emitn("colm", Col(n));
  998.       }
  999. #endif                    /* EvalTrace */
  1000.  
  1001.  
  1002.    }
  1003.  
  1004. #ifdef MultipleRuns
  1005. /*
  1006.  * Reinitialize last file name and line number for repeated runs.
  1007.  */
  1008. novalue tcodeinit()
  1009.    {
  1010.    lastfiln = NULL;
  1011.  
  1012. #ifdef EvalTrace
  1013.    lastcol = 0;
  1014. #endif                    /* EvalTrace */
  1015.  
  1016.    }
  1017. #endif                    /* Multiple Runs */
  1018.  
  1019. /*
  1020.  * The emit* routines output ucode to codefile.  The various routines are:
  1021.  *
  1022.  *  emitlab(l) - emit "lab" instruction for label l.
  1023.  *  emit(s) - emit instruction s.
  1024.  *  emitl(s,a) - emit instruction s with reference to label a.
  1025.  *  emitn(s,n) - emit instruction s with numeric argument a.
  1026.  *  emits(s,a) - emit instruction s with string argument a.
  1027.  */
  1028. static novalue emitlab(l)
  1029. int l;
  1030.    {
  1031.    writecheck(fprintf(codefile, "lab L%d\n", l));
  1032.    }
  1033.  
  1034. static novalue emit(s)
  1035. char *s;
  1036.    {
  1037.    writecheck(fprintf(codefile, "\t%s\n", s));
  1038.    }
  1039.  
  1040. static novalue emitl(s, a)
  1041. char *s;
  1042. int a;
  1043.    {
  1044.    writecheck(fprintf(codefile, "\t%s\tL%d\n", s, a));
  1045.    }
  1046.  
  1047. static novalue emitn(s, a)
  1048. char *s;
  1049. int a;
  1050.    {
  1051.    writecheck(fprintf(codefile, "\t%s\t%d\n", s, a));
  1052.    }
  1053.  
  1054.  
  1055. static novalue emits(s, a)
  1056. char *s, *a;
  1057.    {
  1058.    writecheck(fprintf(codefile, "\t%s\t%s\n", s, a));
  1059.    }
  1060.  
  1061. /*
  1062.  * alclab allocates n labels and returns the first.  For the interpreter,
  1063.  *  labels are restarted at 1 for each procedure, while in the compiler,
  1064.  *  they start at 1 and increase throughout the entire compilation.
  1065.  */
  1066. static int alclab(n)
  1067. int n;
  1068.    {
  1069.    register int lab;
  1070.  
  1071.    lab = nextlab;
  1072.    nextlab += n;
  1073.    return lab;
  1074.    }
  1075.